unit SmallStruct.Database.TSSADODatabaseDriver;

interface

uses Classes,
  ADODB,
  SmallStruct.Database,
  SmallStruct.Database.TSSDatabaseDriver;

type
  ISSADODatabaseDriver = interface(ISSDatabaseDriver)
    ['{36493297-DE6A-481F-AD24-C67DBF608081}']
    function GetConnection: TADOConnection;
  end;

  TSSADODatabaseDriver = class(TSSDatabaseDriver, ISSADODatabaseDriver)
  private
    _Connection: TADOConnection;
  protected
    function GetConnection: TADOConnection;
  public
    function ExecuteProcedure(const ProcedureName: string; Parameters: Variant): Integer; override;
    function ExecuteSQL(const SQL: string): Integer; override;
    function Query(const SQL: string): ISSDataSet; overload; override;
    function QueryByModified(const SQL: string): ISSDataSetModifiable; overload; override; //ISSDataSetModifiable
    function UploadBlobField(const EntityName, KeyFieldName, BlobFieldName: string; Key: Integer; Buffer: TStream): Integer; override;
    function DownloadBlobField(const EntityName, KeyFieldName, BlobFieldName: string; Key: Integer; Buffer: TStream): Integer; override;
    procedure CommitTransaction; override;
    procedure Conntect; override;
    procedure Deconnect; override;
    procedure GetTableNames(ATableNames: TStringList); override;
    procedure GetFieldNames(const ATableName: string; AFieldNames: TStringList); override;
    procedure RollbackTransaction; override;
    procedure StartTransaction; override;
    function AppendTable(const TableName, KeyFieldName: string): Boolean; override;
    function DeleteTable(const TableName: string): Boolean; override;
    function AppendField(const TableName, FieldName, DataType: string): Boolean; override;
    function DeleteField(const TableName, FieldName: string): Boolean; override;
    function FindTable(const TableName: string): Boolean; override;
    function FindField(const TableName, FieldName: string): Boolean; override;
  public
  public
    procedure InitObject; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation

uses
  Dialogs,
  Variants,
  SysUtils,
  Provider,
  DB,
  SmallStruct.Configuration,
  SmallStruct.Tools,
  SmallStruct.Database.TSSDataSet;

{ TSSADODatabaseDriver }

function TSSADODatabaseDriver.AppendField(const TableName, FieldName, DataType: string): Boolean;
begin
  Result := False;
  if not FindTable(TableName) then
    Exit;
  try
    ExecuteSQL('ALTER TABLE ' + TableName + ' ADD ' + FieldName + ' ' + DataType);
    Result := True;
  except
    on E: Exception do
      Result := False;
  end;
end;

function TSSADODatabaseDriver.AppendTable(const TableName, KeyFieldName: string): Boolean;
begin
  Result := False;
  if FindTable(TableName) then
    exit;
  try
    ExecuteSQL('CREATE TABLE ' + TableName + '(' + KeyFieldName + ' INTEGER IDENTITY NOT NULL, CONSTRAINT ' + TableName + '_PK PRIMARY KEY (' + KeyFieldName + '))');
    Result := True;
  except
    on E: Exception do
      Result := False;
  end;
end;

procedure TSSADODatabaseDriver.CommitTransaction;
begin
  if _Connection.Connected then
    _Connection.CommitTrans;
end;

procedure TSSADODatabaseDriver.Conntect;
begin
  _Connection.Open;
end;

constructor TSSADODatabaseDriver.Create(AOwner: TComponent);
begin
  inherited;
  _Connection := TADOConnection.Create(Self);
  _Connection.IsolationLevel := ilReadCommitted;
  _Connection.KeepConnection := False;
  _Connection.LoginPrompt := False;
  _Connection.Mode := cmReadWrite;
  //  _Connection.Connected := True;
end;

procedure TSSADODatabaseDriver.Deconnect;
begin
  _Connection.Close;
end;

function TSSADODatabaseDriver.DeleteField(const TableName, FieldName: string): Boolean;
begin
  Result := False;
  if not FindField(TableName, FieldName) then
    Exit;
  try
    ExecuteSQL('ALTER TABLE ' + TableName + ' DROP ' + FieldName);
    Result := True;
  except
    on E: Exception do
      Result := False;
  end;
end;

function TSSADODatabaseDriver.DeleteTable(const TableName: string): Boolean;
begin
  Result := False;
  if not FindTable(TableName) then
    Exit;
  try
    ExecuteSQL('DROP TABLE ' + TableName);
    Result := True;
  except
    on E: Exception do
      Result := False;
  end;
end;

function TSSADODatabaseDriver.DownloadBlobField(const EntityName, KeyFieldName, BlobFieldName: string; Key: Integer; Buffer: TStream): Integer;
var
  Query: TAdoQuery;
  FieldStream: TStream;
begin
  Query := TAdoQuery.Create(Self);
  Query.Connection := _Connection;
  Query.LockType := ltBatchOptimistic;
  Query.SQL.Text := 'SELECT * FROM ' + EntityName + ' WHERE ' + KeyFieldName + ' = ' + IntToStr(Key);
  try
    Query.Open;
    FieldStream := Query.CreateBlobStream(Query.FieldByName(BlobFieldName), bmRead);
    try
      Buffer.CopyFrom(FieldStream, FieldStream.Size);
      Result := FieldStream.Size;
    finally
      FieldStream.Free;
    end;
  finally
    Query.Free;
  end;
end;

function TSSADODatabaseDriver.ExecuteProcedure(const ProcedureName: string; Parameters: Variant): Integer;
var
  SQL: string;
  Index: Integer;
begin
  if VarArrayHighBound(Parameters, 1) < 1 then
    SQL := ProcedureName
  else if Length(Parameters) = 1 then
    SQL := ProcedureName + '(' + TSSString.VariantToString(Parameters[0]) + ')'
  else
  begin
    SQL := ProcedureName + '(' + TSSString.VariantToString(Parameters[0]);
    for Index := 1 to VarArrayHighBound(Parameters, 1) do
      SQL := SQL + ',' + TSSString.VariantToString(Parameters[Index]);
    SQL := SQL + ')';
  end;

  Result := ExecuteSQL(SQL);
end;

function TSSADODatabaseDriver.ExecuteSQL(const SQL: string): Integer;
begin
  _Connection.Execute(SQL);
  Result := 0;
end;

function TSSADODatabaseDriver.FindField(const TableName, FieldName: string): Boolean;
var
  FieldNames: TStringList;
begin
  Result := False;
  if not FindTable(TableName) then
    Exit;
  FieldNames := TStringList.Create;
  try
    _Connection.GetFieldNames(TableName, FieldNames);
    Result := FieldNames.IndexOf(FieldName) >= 0;
  finally
    FieldNames.Free;
  end;
end;

function TSSADODatabaseDriver.FindTable(const TableName: string): Boolean;
var
  TableNames: TStringList;
begin
  TableNames := TStringList.Create;
  _Connection.GetTableNames(TableNames);
  Result := TableNames.IndexOf(TableName) >= 0;
  TableNames.Free;
end;

function TSSADODatabaseDriver.GetConnection: TADOConnection;
begin
  Result := _Connection;
end;

procedure TSSADODatabaseDriver.GetFieldNames(const ATableName: string; AFieldNames: TStringList);
begin
  _Connection.GetFieldNames(ATableName, AFieldNames);
end;

procedure TSSADODatabaseDriver.GetTableNames(ATableNames: TStringList);
begin
  _Connection.GetTableNames(ATableNames);
end;

procedure TSSADODatabaseDriver.InitObject;
var
  DatabaseConfiguration: ISSDatabaseConnectionConfiguration;
begin
  inherited;
  DatabaseConfiguration := GetContext.GetConfiguration as ISSDatabaseConnectionConfiguration;
  _Connection.ConnectionString := DatabaseConfiguration.GetConnectionString.Text;
end;

function TSSADODatabaseDriver.Query(const SQL: string): ISSDataSet;
var
  SQLQuery: TADOQuery;
  DataSetProvider: TDataSetProvider;
  DataSet: TSSDataSet;
begin
  SQLQuery := TADOQuery.Create(Self);
  DataSetProvider := TDataSetProvider.Create(Self);

  try
    SQLQuery.Connection := _Connection;
    DataSetProvider.DataSet := SQLQuery;

    SQLQuery.SQL.Text := SQL;
    SQLQuery.Prepared := True;
    SQLQuery.AutoCalcFields := False;
    SQLQuery.Open;

    DataSet := TSSDataSet.Create(nil);
    DataSet.InitDataSet(DataSetProvider.Data);

    Result := DataSet;
  finally
    SQLQuery.Free;
    DataSetProvider.Free;
  end;
end;

function TSSADODatabaseDriver.QueryByModified(const SQL: string): ISSDataSetModifiable;
var
  SQLQuery: TADOQuery;
  DataSet: TSSDataSet;
  Index: Integer;
  I: Integer;
begin
  SQLQuery := TADOQuery.Create(Self);

  SQLQuery.Connection := _Connection;

  SQLQuery.SQL.Text := SQL;
  SQLQuery.LockType := ltBatchOptimistic;
  SQLQuery.Prepared := True;
  SQLQuery.AutoCalcFields := False;

  SQLQuery.Open;
  { for Index := 0 to SQLQuery.FieldCount - 1 do
   begin
     if SQLQuery.Fields[Index].FieldName = KeyFieldName then
       SQLQuery.Fields[Index].ProviderFlags := [pfInUpdate]
     else
       SQLQuery.Fields[Index].ProviderFlags := [pfInUpdate];       //pfInWhere    pfInUpdate   pfInKey
   end;
   for Index := 0 to SQLQuery.FieldCount - 1 do
     SQLQuery.Fields[Index].ProviderFlags := [pfInWhere];  }

  DataSet := TSSDataSet.Create(nil);
  DataSet.InitDataSet(SQLQuery);
  DataSet.GetDataSet.Active := True;
  //  DataSet.GetDataSet.Edit;

  Result := DataSet;
end;

procedure TSSADODatabaseDriver.RollbackTransaction;
begin
  if _Connection.Connected then
    _Connection.RollbackTrans;
end;

procedure TSSADODatabaseDriver.StartTransaction;
begin
  if _Connection.Connected then
    _Connection.BeginTrans;
end;

function TSSADODatabaseDriver.UploadBlobField(const EntityName, KeyFieldName, BlobFieldName: string; Key: Integer; Buffer: TStream): Integer;
var
  Query: TAdoQuery;
  FieldStream: TStream;
begin
  Result := 0;
  Query := TAdoQuery.Create(Self);
  Query.Connection := _Connection;
  Query.LockType := ltBatchOptimistic;
  Query.SQL.Text := 'SELECT * FROM ' + EntityName + ' WHERE ' + KeyFieldName + ' = ' + IntToStr(Key);
  try
    Query.Open;
    Query.Edit;
    FieldStream := Query.CreateBlobStream(Query.FieldByName(BlobFieldName), bmWrite);
    FieldStream.CopyFrom(Buffer, Buffer.Size);
    FieldStream.Free;
    Query.UpdateBatch;
  finally
    Query.Free;
  end;
end;

end.
